perm filename COPYIT.F4[P11,LCS] blob
sn#570611 filedate 1981-03-09 generic text, type T, neo UTF8
SUBROUTINE STFCH
CALL CPYIT(1)
END
SUBROUTINE COPYIT
CALL CPYIT(0)
END
SUBROUTINE CPYIT(KC)
INTEGER PWDS
COMMON/XRN/RN(1) /POSI/S(8),JJ2,P
COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
1/PTR/PWDS(1) /LIMIT/LIM,ITEM,LL,I,IX
EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
1,(R6,RJQ(4))
C KC IS FLAG FOR STFCH ROUTINE
IM=ITEM
DO 1 K=1,IM
L=PWDS(K)
IF(RTLINE(L))GO TO 1
IF(OUTLMT(R4,R5,RN(L+3)))GO TO 1
IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
IF(KC.NE.0)GO TO 2
M=RN(L)+2
CALL LOOP(0,M,1,I,L,RN)
ITEM=ITEM+1
L=PWDS(ITEM)
2 IF(R7.LE.7.)RN(L+2)=R7
IF(KC.EQ.0)GO TO 3
IF(K.LT.JJ2)JJ2=K
GO TO 1
3 IF(ITEM.LT.JJ2)JJ2=ITEM
I=I+M+1
PWDS(ITEM+1)=I
1 CONTINUE
IF(KC.EQ.0)R2=R7
END